Group Predictions

Row

Win percentage for the week

Season Win Percentage

Games Correct

31

Games Picked

48

Number of predictions

137

Row

This Week’s Predictions
Game Prediction Winner Correct Correct Votes Correct Percent
1 New York Jets New York Jets Yes 98 0.7153
2 Indianapolis Colts Indianapolis Colts Yes 79 0.5766
3 Tampa Bay Buccaneers Denver Broncos No 7 0.0511
4 Green Bay Packers Green Bay Packers Yes 100 0.7299
5 Houston Texans Minnesota Vikings No 58 0.4234
6 Pittsburgh Steelers Pittsburgh Steelers Yes 70 0.5109
7 Cleveland Browns New York Giants No 23 0.1679
8 New Orleans Saints Philadelphia Eagles No 46 0.3358
9 Las Vegas Raiders Carolina Panthers No 9 0.0657
10 Seattle Seahawks Seattle Seahawks Yes 111 0.8102
11 Baltimore Ravens Baltimore Ravens Yes 91 0.6642
12 Detroit Lions Detroit Lions Yes 91 0.6642
13 San Francisco 49ers Los Angeles Rams No 12 0.0876
14 Kansas City Chiefs Kansas City Chiefs Yes 128 0.9343
15 Buffalo Bills Buffalo Bills Yes 132 0.9635
16 Cincinnati Bengals Washington Commanders No 37 0.2701

Individual Predictions

row

Individual Table

Individual Results
Week 3
Name
Weekly # Correct
Percent Weeks Picked Season Percent Adj Season Percent Season Trend
Week 1 Week 2 Week 3
Akilah Gamble 9 NA 12 0.7500 2 0.6562 0.4375
Diance Durand 9 9 12 0.7500 3 0.6250 0.6250
Louie Renew 9 8 12 0.7500 3 0.6042 0.6042
Lawrence Thuotte 9 5 12 0.7500 3 0.5417 0.5417
Daniel Major 8 10 11 0.6875 3 0.6042 0.6042
Robert Cunningham 14 9 10 0.6250 3 0.6875 0.6875
Travis Delagardelle 11 12 10 0.6250 3 0.6875 0.6875
Jeffrey Rudderforth 11 11 10 0.6250 3 0.6667 0.6667
Bruce Williams 13 9 10 0.6250 3 0.6667 0.6667
Chris Papageorge 14 8 10 0.6250 3 0.6667 0.6667
David Dupree 13 8 10 0.6250 3 0.6458 0.6458
Jennifer Bouland 13 8 10 0.6250 3 0.6458 0.6458
Aubrey Conn 13 7 10 0.6250 3 0.6250 0.6250
Jennifer Wilson 11 9 10 0.6250 3 0.6250 0.6250
Christopher Sims 11 9 10 0.6250 3 0.6250 0.6250
Trevor Macgavin 12 7 10 0.6250 3 0.6042 0.6042
Shawn Carden 10 9 10 0.6250 3 0.6042 0.6042
Nahir Shepard 11 8 10 0.6250 3 0.6042 0.6042
Steward Hogans 10 7 10 0.6250 3 0.5625 0.5625
Ryan Shipley 11 6 10 0.6250 3 0.5625 0.5625
Matthew Schultz 13 10 9 0.5625 3 0.6667 0.6667
Pamela Augustine 14 9 9 0.5625 3 0.6667 0.6667
Jonathan Knight 13 10 9 0.5625 3 0.6667 0.6667
James Small 12 NA 9 0.5625 2 0.6562 0.4375
Robert Gelo 14 8 9 0.5625 3 0.6458 0.6458
Shaun Dahl 14 7 9 0.5625 3 0.6250 0.6250
Kristen White 14 7 9 0.5625 3 0.6250 0.6250
Nathan Brown 13 8 9 0.5625 3 0.6250 0.6250
Marc Agne 14 7 9 0.5625 3 0.6250 0.6250
Kevin Kehoe 13 7 9 0.5625 3 0.6042 0.6042
Michael Linder 11 9 9 0.5625 3 0.6042 0.6042
Paul Presti 12 8 9 0.5625 3 0.6042 0.6042
Daniel Baller 14 6 9 0.5625 3 0.6042 0.6042
Jared Kaanga 11 9 9 0.5625 3 0.6042 0.6042
Erik Neumann 12 8 9 0.5625 3 0.6042 0.6042
Paul Seitz 11 9 9 0.5625 3 0.6042 0.6042
Megan Fitzgerald 8 11 9 0.5625 3 0.5833 0.5833
Michelle Fraterrigo 11 8 9 0.5625 3 0.5833 0.5833
William Schouviller 12 7 9 0.5625 3 0.5833 0.5833
Brandon Parks 12 6 9 0.5625 3 0.5625 0.5625
Ryan Baum 14 4 9 0.5625 3 0.5625 0.5625
Brayant Rivera 10 8 9 0.5625 3 0.5625 0.5625
Ryan Cvik 10 8 9 0.5625 3 0.5625 0.5625
Matthew Olguin 10 8 9 0.5625 3 0.5625 0.5625
Keven Talbert 10 7 9 0.5625 3 0.5417 0.5417
Melissa Printup 8 9 9 0.5625 3 0.5417 0.5417
Jennifer Arty 10 7 9 0.5625 3 0.5417 0.5417
Cheryl Brown 11 6 9 0.5625 3 0.5417 0.5417
Brian Patterson 11 6 9 0.5625 3 0.5417 0.5417
Jamie Ainsleigh-Wong 9 8 9 0.5625 3 0.5417 0.5417
Robert Martin 7 NA 9 0.5625 2 0.5000 0.3333
Keisha Vasquez 8 7 9 0.5625 3 0.5000 0.5000
Steven Webster 7 7 9 0.5625 3 0.4792 0.4792
Andrew Gray 5 8 9 0.5625 3 0.4583 0.4583
Wayne Schofield 7 5 9 0.5625 3 0.4375 0.4375
David Hadley 13 10 8 0.5000 3 0.6458 0.6458
Cherylynn Vidal 13 9 8 0.5000 3 0.6250 0.6250
George Hall 12 NA 8 0.5000 2 0.6250 0.4167
Derrick Elam 13 9 8 0.5000 3 0.6250 0.6250
Michael Moss 13 8 8 0.5000 3 0.6042 0.6042
Chester Todd 13 8 8 0.5000 3 0.6042 0.6042
Rafael Torres 12 9 8 0.5000 3 0.6042 0.6042
Anthony Bloss 13 8 8 0.5000 3 0.6042 0.6042
George Brown 14 7 8 0.5000 3 0.6042 0.6042
Bradley Hobson 13 7 8 0.5000 3 0.5833 0.5833
Kevin Buettner 12 8 8 0.5000 3 0.5833 0.5833
Nicole Dike 13 7 8 0.5000 3 0.5833 0.5833
Jeremy Mounce 12 8 8 0.5000 3 0.5833 0.5833
Jose Torres Mendoza 12 8 8 0.5000 3 0.5833 0.5833
David Humes 10 9 8 0.5000 3 0.5625 0.5625
Tara Bridgett 11 8 8 0.5000 3 0.5625 0.5625
Philip Driskill 12 7 8 0.5000 3 0.5625 0.5625
Antonio Mitchell 11 7 8 0.5000 3 0.5417 0.5417
Randolph Tidd 11 7 8 0.5000 3 0.5417 0.5417
Kamar Morgan 12 6 8 0.5000 3 0.5417 0.5417
Scott Lefton 10 8 8 0.5000 3 0.5417 0.5417
Daniel Halse 12 6 8 0.5000 3 0.5417 0.5417
Randy Dick 11 7 8 0.5000 3 0.5417 0.5417
David Plate 10 8 8 0.5000 3 0.5417 0.5417
Bunnaro Sun 12 5 8 0.5000 3 0.5208 0.5208
Cade Martinez 10 7 8 0.5000 3 0.5208 0.5208
Joshua Tracey 12 5 8 0.5000 3 0.5208 0.5208
Joseph Martin 10 7 8 0.5000 3 0.5208 0.5208
Jason Miranda 10 7 8 0.5000 3 0.5208 0.5208
Michael Branson 9 8 8 0.5000 3 0.5208 0.5208
Vincent Kandian 9 8 8 0.5000 3 0.5208 0.5208
Zechariah Ziebarth 8 8 8 0.5000 3 0.5000 0.5000
Montee Brown 10 6 8 0.5000 3 0.5000 0.5000
Robert Lynch 6 9 8 0.5000 3 0.4792 0.4792
Pablo Burgosramos 9 5 8 0.5000 3 0.4583 0.4583
Heather Kohler 12 NA 7 0.4375 2 0.5938 0.3959
Yiming Hu 12 NA 7 0.4375 2 0.5938 0.3959
Heather Ellenberger 13 8 7 0.4375 3 0.5833 0.5833
Michael Pacifico 13 8 7 0.4375 3 0.5833 0.5833
Kenneth Nielsen 13 8 7 0.4375 3 0.5833 0.5833
Christopher Mulcahy 11 9 7 0.4375 3 0.5625 0.5625
Patrick Tynan 12 8 7 0.4375 3 0.5625 0.5625
Karen Richardson 10 9 7 0.4375 3 0.5417 0.5417
Jay Kelly 10 9 7 0.4375 3 0.5417 0.5417
Bryson Scott 10 9 7 0.4375 3 0.5417 0.5417
Min Choi 10 NA 7 0.4375 2 0.5312 0.3541
Jonathon Leslein 10 8 7 0.4375 3 0.5208 0.5208
Ramar Williams 10 8 7 0.4375 3 0.5208 0.5208
Vincent Scannelli 11 7 7 0.4375 3 0.5208 0.5208
Desmond Jenkins 10 7 7 0.4375 3 0.5000 0.5000
Michael Moore 11 6 7 0.4375 3 0.5000 0.5000
Walter Archambo 8 8 7 0.4375 3 0.4792 0.4792
Rachel Follo 15 8 6 0.3750 3 0.6042 0.6042
Gregory Brown 15 7 6 0.3750 3 0.5833 0.5833
George Sweet 13 9 6 0.3750 3 0.5833 0.5833
Darryle Sellers 11 11 6 0.3750 3 0.5833 0.5833
Anthony Rockemore 13 8 6 0.3750 3 0.5625 0.5625
Terry Hardison 13 8 6 0.3750 3 0.5625 0.5625
Jeffrey Zornes 9 11 6 0.3750 3 0.5417 0.5417
Jeremy Stieler 11 9 6 0.3750 3 0.5417 0.5417
Jason Schattel 13 7 6 0.3750 3 0.5417 0.5417
George Mancini 11 8 6 0.3750 3 0.5208 0.5208
Earl Dixon 10 9 6 0.3750 3 0.5208 0.5208
Amy Asberry 11 8 6 0.3750 3 0.5208 0.5208
Jordan Forwood 11 8 6 0.3750 3 0.5208 0.5208
Darvin Graham 12 7 6 0.3750 3 0.5208 0.5208
Richard Beeghley 11 7 6 0.3750 3 0.5000 0.5000
Gabriel Quinones 10 7 6 0.3750 3 0.4792 0.4792
Thomas Mccoy 10 7 6 0.3750 3 0.4792 0.4792
Ashley Johnson 9 NA 6 0.3750 2 0.4688 0.3125
Donald Park 9 NA 6 0.3750 2 0.4688 0.3125
Edward Ford 9 7 6 0.3750 3 0.4583 0.4583
Richard Conkle 7 6 6 0.3750 3 0.3958 0.3958
Ronald Schmidt 10 10 5 0.3125 3 0.5208 0.5208
Nicholas Nguyen 11 8 5 0.3125 3 0.5000 0.5000
Jason Jackson 12 7 5 0.3125 3 0.5000 0.5000
Kyle May 10 8 5 0.3125 3 0.4792 0.4792
Gabrieal Feiling 10 NA 5 0.3125 2 0.4688 0.3125
Gary Lawrence 10 6 5 0.3125 3 0.4375 0.4375
Jack Wheeler 9 6 5 0.3125 3 0.4167 0.4167
Jonathan Smith 11 NA 4 0.2500 2 0.4688 0.3125
Stephen Bush 9 7 4 0.2500 3 0.4167 0.4167
Clayton Grimes 14 NA NA 0.0000 1 0.8750 0.2917
Wallace Savage 12 NA NA 0.0000 1 0.7500 0.2500
Brian Holder 12 NA NA 0.0000 1 0.7500 0.2500
Sandra Carter 12 NA NA 0.0000 1 0.7500 0.2500
Jeremy Krammes 12 NA NA 0.0000 1 0.7500 0.2500
Terrence Lee 11 NA NA 0.0000 1 0.6875 0.2292
Daniel Gray 11 NA NA 0.0000 1 0.6875 0.2292
Wayne Gokey 13 7 NA 0.0000 2 0.6250 0.4167
Nicholas Cinco 12 8 NA 0.0000 2 0.6250 0.4167
Clevante Granville 9 11 NA 0.0000 2 0.6250 0.4167
Kevin Green 11 9 NA 0.0000 2 0.6250 0.4167
Karen Coleman 13 6 NA 0.0000 2 0.5938 0.3959
Jeffrey Dusza 11 8 NA 0.0000 2 0.5938 0.3959
Marcus Evans 11 8 NA 0.0000 2 0.5938 0.3959
Adam Konkle 10 9 NA 0.0000 2 0.5938 0.3959
Ashlyn Dortch 9 NA NA 0.0000 1 0.5625 0.1875
Robert Sokol 10 8 NA 0.0000 2 0.5625 0.3750
Sheryl Claiborne-Smith 11 7 NA 0.0000 2 0.5625 0.3750
Anthony Brinson 11 7 NA 0.0000 2 0.5625 0.3750
Monte Henderson 9 8 NA 0.0000 2 0.5312 0.3541
Thomas Brenstuhl 9 8 NA 0.0000 2 0.5312 0.3541
David Kim 9 8 NA 0.0000 2 0.5312 0.3541
Zachary Brosemer 8 NA NA 0.0000 1 0.5000 0.1667
Thomas Cho 10 6 NA 0.0000 2 0.5000 0.3333
Antonio Chapa 8 NA NA 0.0000 1 0.5000 0.1667
Noah Gosswiller 8 7 NA 0.0000 2 0.4688 0.3125
Jasprin Smith 6 NA NA 0.0000 1 0.3750 0.1250
Robert Epps NA 6 NA 0.0000 1 0.3750 0.1250

Season Leaderboard

Season Leaderboard (Season Percent)
Week 3
Season Rank Name Donuts Won Weeks Picked Season Percent Adj Season Percent Season Trend
1 Clayton Grimes 0 1 0.8750 0.2917
2 Brian Holder 0 1 0.7500 0.2500
2 Jeremy Krammes 0 1 0.7500 0.2500
2 Sandra Carter 0 1 0.7500 0.2500
2 Wallace Savage 0 1 0.7500 0.2500
6 Daniel Gray 0 1 0.6875 0.2292
6 Robert Cunningham 0 3 0.6875 0.6875
6 Terrence Lee 0 1 0.6875 0.2292
6 Travis Delagardelle 1 3 0.6875 0.6875
10 Bruce Williams 0 3 0.6667 0.6667
10 Chris Papageorge 0 3 0.6667 0.6667
10 Jeffrey Rudderforth 0 3 0.6667 0.6667
10 Jonathan Knight 0 3 0.6667 0.6667
10 Matthew Schultz 0 3 0.6667 0.6667
10 Pamela Augustine 0 3 0.6667 0.6667
16 Akilah Gamble 1 2 0.6562 0.4375
16 James Small 0 2 0.6562 0.4375
18 David Dupree 0 3 0.6458 0.6458
18 David Hadley 0 3 0.6458 0.6458
18 Jennifer Bouland 0 3 0.6458 0.6458
18 Robert Gelo 0 3 0.6458 0.6458
22 Aubrey Conn 0 3 0.6250 0.6250
22 Cherylynn Vidal 0 3 0.6250 0.6250
22 Christopher Sims 0 3 0.6250 0.6250
22 Clevante Granville 0 2 0.6250 0.4167
22 Derrick Elam 0 3 0.6250 0.6250
22 Diance Durand 1 3 0.6250 0.6250
22 George Hall 0 2 0.6250 0.4167
22 Jennifer Wilson 0 3 0.6250 0.6250
22 Kevin Green 0 2 0.6250 0.4167
22 Kristen White 0 3 0.6250 0.6250
22 Marc Agne 0 3 0.6250 0.6250
22 Nathan Brown 0 3 0.6250 0.6250
22 Nicholas Cinco 0 2 0.6250 0.4167
22 Shaun Dahl 0 3 0.6250 0.6250
22 Wayne Gokey 0 2 0.6250 0.4167
37 Anthony Bloss 0 3 0.6042 0.6042
37 Chester Todd 0 3 0.6042 0.6042
37 Daniel Baller 0 3 0.6042 0.6042
37 Daniel Major 0 3 0.6042 0.6042
37 Erik Neumann 0 3 0.6042 0.6042
37 George Brown 0 3 0.6042 0.6042
37 Jared Kaanga 0 3 0.6042 0.6042
37 Kevin Kehoe 0 3 0.6042 0.6042
37 Louie Renew 1 3 0.6042 0.6042
37 Michael Linder 0 3 0.6042 0.6042
37 Michael Moss 0 3 0.6042 0.6042
37 Nahir Shepard 0 3 0.6042 0.6042
37 Paul Presti 0 3 0.6042 0.6042
37 Paul Seitz 0 3 0.6042 0.6042
37 Rachel Follo 1 3 0.6042 0.6042
37 Rafael Torres 0 3 0.6042 0.6042
37 Shawn Carden 0 3 0.6042 0.6042
37 Trevor Macgavin 0 3 0.6042 0.6042
55 Adam Konkle 0 2 0.5938 0.3959
55 Heather Kohler 0 2 0.5938 0.3959
55 Jeffrey Dusza 0 2 0.5938 0.3959
55 Karen Coleman 0 2 0.5938 0.3959
55 Marcus Evans 0 2 0.5938 0.3959
55 Yiming Hu 0 2 0.5938 0.3959
61 Bradley Hobson 0 3 0.5833 0.5833
61 Darryle Sellers 0 3 0.5833 0.5833
61 George Sweet 0 3 0.5833 0.5833
61 Gregory Brown 1 3 0.5833 0.5833
61 Heather Ellenberger 0 3 0.5833 0.5833
61 Jeremy Mounce 0 3 0.5833 0.5833
61 Jose Torres Mendoza 0 3 0.5833 0.5833
61 Kenneth Nielsen 0 3 0.5833 0.5833
61 Kevin Buettner 0 3 0.5833 0.5833
61 Megan Fitzgerald 0 3 0.5833 0.5833
61 Michael Pacifico 0 3 0.5833 0.5833
61 Michelle Fraterrigo 0 3 0.5833 0.5833
61 Nicole Dike 0 3 0.5833 0.5833
61 William Schouviller 0 3 0.5833 0.5833
75 Anthony Brinson 0 2 0.5625 0.3750
75 Anthony Rockemore 0 3 0.5625 0.5625
75 Ashlyn Dortch 0 1 0.5625 0.1875
75 Brandon Parks 0 3 0.5625 0.5625
75 Brayant Rivera 0 3 0.5625 0.5625
75 Christopher Mulcahy 0 3 0.5625 0.5625
75 David Humes 0 3 0.5625 0.5625
75 Matthew Olguin 0 3 0.5625 0.5625
75 Patrick Tynan 0 3 0.5625 0.5625
75 Philip Driskill 0 3 0.5625 0.5625
75 Robert Sokol 0 2 0.5625 0.3750
75 Ryan Baum 0 3 0.5625 0.5625
75 Ryan Cvik 0 3 0.5625 0.5625
75 Ryan Shipley 0 3 0.5625 0.5625
75 Sheryl Claiborne-Smith 0 2 0.5625 0.3750
75 Steward Hogans 0 3 0.5625 0.5625
75 Tara Bridgett 0 3 0.5625 0.5625
75 Terry Hardison 0 3 0.5625 0.5625
93 Antonio Mitchell 0 3 0.5417 0.5417
93 Brian Patterson 0 3 0.5417 0.5417
93 Bryson Scott 0 3 0.5417 0.5417
93 Cheryl Brown 0 3 0.5417 0.5417
93 Daniel Halse 0 3 0.5417 0.5417
93 David Plate 0 3 0.5417 0.5417
93 Jamie Ainsleigh-Wong 0 3 0.5417 0.5417
93 Jason Schattel 0 3 0.5417 0.5417
93 Jay Kelly 0 3 0.5417 0.5417
93 Jeffrey Zornes 0 3 0.5417 0.5417
93 Jennifer Arty 0 3 0.5417 0.5417
93 Jeremy Stieler 0 3 0.5417 0.5417
93 Kamar Morgan 0 3 0.5417 0.5417
93 Karen Richardson 0 3 0.5417 0.5417
93 Keven Talbert 0 3 0.5417 0.5417
93 Lawrence Thuotte 1 3 0.5417 0.5417
93 Melissa Printup 0 3 0.5417 0.5417
93 Randolph Tidd 0 3 0.5417 0.5417
93 Randy Dick 0 3 0.5417 0.5417
93 Scott Lefton 0 3 0.5417 0.5417
113 David Kim 0 2 0.5312 0.3541
113 Min Choi 0 2 0.5312 0.3541
113 Monte Henderson 0 2 0.5312 0.3541
113 Thomas Brenstuhl 0 2 0.5312 0.3541
117 Amy Asberry 0 3 0.5208 0.5208
117 Bunnaro Sun 0 3 0.5208 0.5208
117 Cade Martinez 0 3 0.5208 0.5208
117 Darvin Graham 0 3 0.5208 0.5208
117 Earl Dixon 0 3 0.5208 0.5208
117 George Mancini 0 3 0.5208 0.5208
117 Jason Miranda 0 3 0.5208 0.5208
117 Jonathon Leslein 0 3 0.5208 0.5208
117 Jordan Forwood 0 3 0.5208 0.5208
117 Joseph Martin 0 3 0.5208 0.5208
117 Joshua Tracey 0 3 0.5208 0.5208
117 Michael Branson 0 3 0.5208 0.5208
117 Ramar Williams 0 3 0.5208 0.5208
117 Ronald Schmidt 0 3 0.5208 0.5208
117 Vincent Kandian 0 3 0.5208 0.5208
117 Vincent Scannelli 0 3 0.5208 0.5208
133 Antonio Chapa 0 1 0.5000 0.1667
133 Desmond Jenkins 0 3 0.5000 0.5000
133 Jason Jackson 0 3 0.5000 0.5000
133 Keisha Vasquez 0 3 0.5000 0.5000
133 Michael Moore 0 3 0.5000 0.5000
133 Montee Brown 0 3 0.5000 0.5000
133 Nicholas Nguyen 0 3 0.5000 0.5000
133 Richard Beeghley 0 3 0.5000 0.5000
133 Robert Martin 0 2 0.5000 0.3333
133 Thomas Cho 0 2 0.5000 0.3333
133 Zachary Brosemer 0 1 0.5000 0.1667
133 Zechariah Ziebarth 0 3 0.5000 0.5000
145 Gabriel Quinones 0 3 0.4792 0.4792
145 Kyle May 0 3 0.4792 0.4792
145 Robert Lynch 0 3 0.4792 0.4792
145 Steven Webster 0 3 0.4792 0.4792
145 Thomas Mccoy 0 3 0.4792 0.4792
145 Walter Archambo 0 3 0.4792 0.4792
151 Ashley Johnson 0 2 0.4688 0.3125
151 Donald Park 0 2 0.4688 0.3125
151 Gabrieal Feiling 0 2 0.4688 0.3125
151 Jonathan Smith 0 2 0.4688 0.3125
151 Noah Gosswiller 0 2 0.4688 0.3125
156 Andrew Gray 0 3 0.4583 0.4583
156 Edward Ford 0 3 0.4583 0.4583
156 Pablo Burgosramos 0 3 0.4583 0.4583
159 Gary Lawrence 0 3 0.4375 0.4375
159 Wayne Schofield 0 3 0.4375 0.4375
161 Jack Wheeler 0 3 0.4167 0.4167
161 Stephen Bush 0 3 0.4167 0.4167
163 Richard Conkle 0 3 0.3958 0.3958
164 Jasprin Smith 0 1 0.3750 0.1250
164 Robert Epps 0 1 0.3750 0.1250

Adjusted Season Leaderboard

Season Leaderboard (Adjusted Season Percent)
Week 3
Season Rank Name Donuts Won Weeks Picked Season Percent Adj Season Percent Season Trend
1 Robert Cunningham 0 3 0.6875 0.6875
1 Travis Delagardelle 1 3 0.6875 0.6875
3 Bruce Williams 0 3 0.6667 0.6667
3 Chris Papageorge 0 3 0.6667 0.6667
3 Jeffrey Rudderforth 0 3 0.6667 0.6667
3 Jonathan Knight 0 3 0.6667 0.6667
3 Matthew Schultz 0 3 0.6667 0.6667
3 Pamela Augustine 0 3 0.6667 0.6667
9 David Dupree 0 3 0.6458 0.6458
9 David Hadley 0 3 0.6458 0.6458
9 Jennifer Bouland 0 3 0.6458 0.6458
9 Robert Gelo 0 3 0.6458 0.6458
13 Aubrey Conn 0 3 0.6250 0.6250
13 Cherylynn Vidal 0 3 0.6250 0.6250
13 Christopher Sims 0 3 0.6250 0.6250
13 Derrick Elam 0 3 0.6250 0.6250
13 Diance Durand 1 3 0.6250 0.6250
13 Jennifer Wilson 0 3 0.6250 0.6250
13 Kristen White 0 3 0.6250 0.6250
13 Marc Agne 0 3 0.6250 0.6250
13 Nathan Brown 0 3 0.6250 0.6250
13 Shaun Dahl 0 3 0.6250 0.6250
23 Anthony Bloss 0 3 0.6042 0.6042
23 Chester Todd 0 3 0.6042 0.6042
23 Daniel Baller 0 3 0.6042 0.6042
23 Daniel Major 0 3 0.6042 0.6042
23 Erik Neumann 0 3 0.6042 0.6042
23 George Brown 0 3 0.6042 0.6042
23 Jared Kaanga 0 3 0.6042 0.6042
23 Kevin Kehoe 0 3 0.6042 0.6042
23 Louie Renew 1 3 0.6042 0.6042
23 Michael Linder 0 3 0.6042 0.6042
23 Michael Moss 0 3 0.6042 0.6042
23 Nahir Shepard 0 3 0.6042 0.6042
23 Paul Presti 0 3 0.6042 0.6042
23 Paul Seitz 0 3 0.6042 0.6042
23 Rachel Follo 1 3 0.6042 0.6042
23 Rafael Torres 0 3 0.6042 0.6042
23 Shawn Carden 0 3 0.6042 0.6042
23 Trevor Macgavin 0 3 0.6042 0.6042
41 Bradley Hobson 0 3 0.5833 0.5833
41 Darryle Sellers 0 3 0.5833 0.5833
41 George Sweet 0 3 0.5833 0.5833
41 Gregory Brown 1 3 0.5833 0.5833
41 Heather Ellenberger 0 3 0.5833 0.5833
41 Jeremy Mounce 0 3 0.5833 0.5833
41 Jose Torres Mendoza 0 3 0.5833 0.5833
41 Kenneth Nielsen 0 3 0.5833 0.5833
41 Kevin Buettner 0 3 0.5833 0.5833
41 Megan Fitzgerald 0 3 0.5833 0.5833
41 Michael Pacifico 0 3 0.5833 0.5833
41 Michelle Fraterrigo 0 3 0.5833 0.5833
41 Nicole Dike 0 3 0.5833 0.5833
41 William Schouviller 0 3 0.5833 0.5833
55 Anthony Rockemore 0 3 0.5625 0.5625
55 Brandon Parks 0 3 0.5625 0.5625
55 Brayant Rivera 0 3 0.5625 0.5625
55 Christopher Mulcahy 0 3 0.5625 0.5625
55 David Humes 0 3 0.5625 0.5625
55 Matthew Olguin 0 3 0.5625 0.5625
55 Patrick Tynan 0 3 0.5625 0.5625
55 Philip Driskill 0 3 0.5625 0.5625
55 Ryan Baum 0 3 0.5625 0.5625
55 Ryan Cvik 0 3 0.5625 0.5625
55 Ryan Shipley 0 3 0.5625 0.5625
55 Steward Hogans 0 3 0.5625 0.5625
55 Tara Bridgett 0 3 0.5625 0.5625
55 Terry Hardison 0 3 0.5625 0.5625
69 Antonio Mitchell 0 3 0.5417 0.5417
69 Brian Patterson 0 3 0.5417 0.5417
69 Bryson Scott 0 3 0.5417 0.5417
69 Cheryl Brown 0 3 0.5417 0.5417
69 Daniel Halse 0 3 0.5417 0.5417
69 David Plate 0 3 0.5417 0.5417
69 Jamie Ainsleigh-Wong 0 3 0.5417 0.5417
69 Jason Schattel 0 3 0.5417 0.5417
69 Jay Kelly 0 3 0.5417 0.5417
69 Jeffrey Zornes 0 3 0.5417 0.5417
69 Jennifer Arty 0 3 0.5417 0.5417
69 Jeremy Stieler 0 3 0.5417 0.5417
69 Kamar Morgan 0 3 0.5417 0.5417
69 Karen Richardson 0 3 0.5417 0.5417
69 Keven Talbert 0 3 0.5417 0.5417
69 Lawrence Thuotte 1 3 0.5417 0.5417
69 Melissa Printup 0 3 0.5417 0.5417
69 Randolph Tidd 0 3 0.5417 0.5417
69 Randy Dick 0 3 0.5417 0.5417
69 Scott Lefton 0 3 0.5417 0.5417
89 Amy Asberry 0 3 0.5208 0.5208
89 Bunnaro Sun 0 3 0.5208 0.5208
89 Cade Martinez 0 3 0.5208 0.5208
89 Darvin Graham 0 3 0.5208 0.5208
89 Earl Dixon 0 3 0.5208 0.5208
89 George Mancini 0 3 0.5208 0.5208
89 Jason Miranda 0 3 0.5208 0.5208
89 Jonathon Leslein 0 3 0.5208 0.5208
89 Jordan Forwood 0 3 0.5208 0.5208
89 Joseph Martin 0 3 0.5208 0.5208
89 Joshua Tracey 0 3 0.5208 0.5208
89 Michael Branson 0 3 0.5208 0.5208
89 Ramar Williams 0 3 0.5208 0.5208
89 Ronald Schmidt 0 3 0.5208 0.5208
89 Vincent Kandian 0 3 0.5208 0.5208
89 Vincent Scannelli 0 3 0.5208 0.5208
105 Desmond Jenkins 0 3 0.5000 0.5000
105 Jason Jackson 0 3 0.5000 0.5000
105 Keisha Vasquez 0 3 0.5000 0.5000
105 Michael Moore 0 3 0.5000 0.5000
105 Montee Brown 0 3 0.5000 0.5000
105 Nicholas Nguyen 0 3 0.5000 0.5000
105 Richard Beeghley 0 3 0.5000 0.5000
105 Zechariah Ziebarth 0 3 0.5000 0.5000
113 Gabriel Quinones 0 3 0.4792 0.4792
113 Kyle May 0 3 0.4792 0.4792
113 Robert Lynch 0 3 0.4792 0.4792
113 Steven Webster 0 3 0.4792 0.4792
113 Thomas Mccoy 0 3 0.4792 0.4792
113 Walter Archambo 0 3 0.4792 0.4792
119 Andrew Gray 0 3 0.4583 0.4583
119 Edward Ford 0 3 0.4583 0.4583
119 Pablo Burgosramos 0 3 0.4583 0.4583
122 Akilah Gamble 1 2 0.6562 0.4375
122 Gary Lawrence 0 3 0.4375 0.4375
122 James Small 0 2 0.6562 0.4375
122 Wayne Schofield 0 3 0.4375 0.4375
126 Clevante Granville 0 2 0.6250 0.4167
126 George Hall 0 2 0.6250 0.4167
126 Jack Wheeler 0 3 0.4167 0.4167
126 Kevin Green 0 2 0.6250 0.4167
126 Nicholas Cinco 0 2 0.6250 0.4167
126 Stephen Bush 0 3 0.4167 0.4167
126 Wayne Gokey 0 2 0.6250 0.4167
133 Adam Konkle 0 2 0.5938 0.3959
133 Heather Kohler 0 2 0.5938 0.3959
133 Jeffrey Dusza 0 2 0.5938 0.3959
133 Karen Coleman 0 2 0.5938 0.3959
133 Marcus Evans 0 2 0.5938 0.3959
133 Yiming Hu 0 2 0.5938 0.3959
139 Richard Conkle 0 3 0.3958 0.3958
140 Anthony Brinson 0 2 0.5625 0.3750
140 Robert Sokol 0 2 0.5625 0.3750
140 Sheryl Claiborne-Smith 0 2 0.5625 0.3750
143 David Kim 0 2 0.5312 0.3541
143 Min Choi 0 2 0.5312 0.3541
143 Monte Henderson 0 2 0.5312 0.3541
143 Thomas Brenstuhl 0 2 0.5312 0.3541
147 Robert Martin 0 2 0.5000 0.3333
147 Thomas Cho 0 2 0.5000 0.3333
149 Ashley Johnson 0 2 0.4688 0.3125
149 Donald Park 0 2 0.4688 0.3125
149 Gabrieal Feiling 0 2 0.4688 0.3125
149 Jonathan Smith 0 2 0.4688 0.3125
149 Noah Gosswiller 0 2 0.4688 0.3125
154 Clayton Grimes 0 1 0.8750 0.2917
155 Brian Holder 0 1 0.7500 0.2500
155 Jeremy Krammes 0 1 0.7500 0.2500
155 Sandra Carter 0 1 0.7500 0.2500
155 Wallace Savage 0 1 0.7500 0.2500
159 Daniel Gray 0 1 0.6875 0.2292
159 Terrence Lee 0 1 0.6875 0.2292
161 Ashlyn Dortch 0 1 0.5625 0.1875
162 Antonio Chapa 0 1 0.5000 0.1667
162 Zachary Brosemer 0 1 0.5000 0.1667
164 Jasprin Smith 0 1 0.3750 0.1250
164 Robert Epps 0 1 0.3750 0.1250

Data

---
title: "2025 NFL Moneyline Picks"
output: 
  flexdashboard::flex_dashboard:
    theme:
      version: 4
      bootswatch: spacelab
    orientation: rows
    vertical_layout: fill
    social: ["menu"]
    source_code: embed
    navbar:
      - { title: "Created by: Daniel Baller", icon: "fa-github", href: "https://github.com/danielpballer"  }
---


```{r setup, include=FALSE}
#    source_code: embed
options(show.error.messages = FALSE)
library(flexdashboard)
library(tidyverse)
library(data.table)
library(formattable)
library(ggpubr)
library(ggrepel)
library(gt)
library(glue)
library(ggthemes)
library(hrbrthemes)
library(sparkline)
library(plotly)
library(htmlwidgets)
#library(mdthemes)
library(ggtext)
library(ggnewscale)
library(DT)
source("./Functions/functions2.R")

thematic::thematic_rmd(font = "auto")

# Use line 211 if you need to hard code any losses for a week
```

```{r Reading in our picks files, include=FALSE}
current_week = 3 #Set what week it is
week_1 = read_csv("./CSV_Data_Files/2024 NFL Week 1.csv") %>% 
  mutate(Name = str_to_title(Name))
week_2 = read_csv("./CSV_Data_Files/2024 NFL Week 2.csv")%>% 
  mutate(Name = str_to_title(Name))
week_3 = read_csv("./CSV_Data_Files/2024 NFL Week 3.csv")%>% 
  mutate(Name = str_to_title(Name))
# week_4 = read_csv("./CSV_Data_Files/2024 NFL Week 4.csv")%>%
#  mutate(Name = str_to_title(Name))
# week_5 = read_csv("./CSV_Data_Files/2024 NFL Week 5.csv")%>% 
#   mutate(Name = str_to_title(Name))
# week_6 = read_csv("./CSV_Data_Files/2024 NFL Week 6.csv")%>% 
#   mutate(Name = str_to_title(Name))
# week_7 = read_csv("./CSV_Data_Files/2024 NFL Week 7.csv")%>% 
#   mutate(Name = str_to_title(Name))
# week_8 = read_csv("./CSV_Data_Files/2024 NFL Week 8.csv")%>% 
#   mutate(Name = str_to_title(Name))
#  week_9 = read_csv("./CSV_Data_Files/2024 NFL Week 9.csv")%>% 
#   mutate(Name = str_to_title(Name))
# week_10 = read_csv("./CSV_Data_Files/2024 NFL Week 10.csv")%>% 
#   mutate(Name = str_to_title(Name))
# week_11 = read_csv("./CSV_Data_Files/2024 NFL Week 11.csv")%>% 
#   mutate(Name = str_to_title(Name))
# week_12 = read_csv("./CSV_Data_Files/2024 NFL Week 12.csv")%>% 
#   mutate(Name = str_to_title(Name))
# week_13 = read_csv("./CSV_Data_Files/2024 NFL Week 13.csv")%>% 
#   mutate(Name = str_to_title(Name))
# week_14 = read_csv("./CSV_Data_Files/2024 NFL Week 14.csv")%>% 
#   mutate(Name = str_to_title(Name))
# week_15 = read_csv("./CSV_Data_Files/2024 NFL Week 15.csv")%>% 
#   mutate(Name = str_to_title(Name))
# week_16 = read_csv("./CSV_Data_Files/2024 NFL Week 16.csv")%>% 
#   mutate(Name = str_to_title(Name))
# week_17 = read_csv("./CSV_Data_Files/2024 NFL Week 17.csv")%>% 
#   mutate(Name = str_to_title(Name))
# week_18 = read_csv("./CSV_Data_Files/2024 NFL Week 18.csv")%>% 
#   mutate(Name = str_to_title(Name))
# week_19 = read_csv("./CSV_Data_Files/2024 NFL Wild Card.csv")%>% 
#   mutate(Name = str_to_title(Name))
# week_20 = read_csv("./CSV_Data_Files/2024 NFL Divisional Week.csv")%>% 
#   mutate(Name = str_to_title(Name))
# week_21 = read_csv("./CSV_Data_Files/2024 NFL Conference Round.csv")%>% 
# mutate(Name = str_to_title(Name))
# week_22 = read_csv("./CSV_Data_Files/2024 NFL Super Bowl.csv")%>% 
#   mutate(Name = str_to_title(Name))

#reading in scores
Scores = read_csv(glue::glue("./CSV_Data_Files/NFL_Scores_{current_week}.csv")) 

#reading in CBS Prediction Records
cbs = read_csv(glue::glue("./CSV_Data_Files/CBS_Experts_{current_week}.csv")) %>% 
  mutate(Percent = round(Percent,4))
cbs_season = read_csv(glue::glue("./CSV_Data_Files/CBS_Experts_Season_{current_week}.csv"))

#reading in ESPN Prediction Records
espn = read_csv(glue::glue("./CSV_Data_Files/ESPN_Experts_{current_week}.csv"))%>% 
  mutate(Percent = round(Percent,4))
espn_season = read_csv(glue::glue("./CSV_Data_Files/ESPN_Experts_Season_{current_week}.csv"))%>% 
  mutate(Percent = round(Percent,4))

#Odds not working for the 2024 season.  Need to fix scrape code for next year.
#Reading in the moneyline odds for each team and cleaning the team names
# odds_wk1 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_1.csv"))
# odds_wk2 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_2.csv"))
# odds_wk3 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_3.csv"))
# odds_wk4 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_4.csv"))
# odds_wk5 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_5.csv"))
# odds_wk6 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_6.csv"))
# odds_wk7 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_7.csv"))
# odds_wk8 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_8.csv"))
# odds_wk9 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_9.csv"))
# odds_wk10 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_10.csv"))
# odds_wk11 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_11.csv"))
# odds_wk12 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_12.csv"))
# odds_wk13 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_13.csv"))
# odds_wk14 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_14.csv"))
# odds_wk15 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_15.csv"))
# odds_wk16 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_16.csv"))
# odds_wk17 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_17.csv"))
# odds_wk18 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_18.csv"))
# odds_wk19 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_19.csv"))
# odds_wk20 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_20.csv"))
# odds_wk21 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_21.csv"))
# odds_wk22 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_22.csv"))

####################UPDATE THESE###############################
inst.picks = list(week_1, week_2, week_3) #, week_4, week_5, week_6, week_7, week_8 , week_9, week_10, week_11, week_12, week_13, week_14, week_15, week_16, week_17, week_18, week_19, week_20, week_21, week_22) #add in the additional weeks
#odds = rbind(odds_wk1, odds_wk2, odds_wk3, odds_wk4, odds_wk5, odds_wk6, odds_wk7, odds_wk8,
#              odds_wk9, odds_wk10, odds_wk11, odds_wk12) #add in the additional weeks
####################END OF UPDATE##############################

weeks = as.list(seq(1:current_week)) #creating a list of each week number
```

```{r read in scores clean data, include=FALSE}
#Cleaning Odds Data
# cl_odds = odds_cleaning(odds)

#Cleaning scores data
Scores = cleaning2(Scores)

#creating a list of winners for each week
winners = map(weeks, weekly_winners)

#creating a vector of this weeks winners
this_week = pull(winners[[length(winners)]])  

#Getting the number of games for each week
weekly_number_of_games = map_dbl(weeks, week_number_games)
```

```{r Group Predictions, include=FALSE}
#Creating the list of everyones predictions each week.
games = map(inst.picks, games_fn)

#Creating the prediction table.  
pred_table = map(games, pred_table_fn)

#Adding who won to the predictions
with_winners = map2(pred_table, winners, adding_winners)

#Creating results for each week.
results = map2(with_winners,weekly_number_of_games, results_fn)
```


```{r Displaying Group Results, echo=FALSE}
#Displaying the group results

inst_group_table = results[[length(results)]] %>% gt() %>% 
  cols_align(
    align = "center") %>% 
   tab_header(
    title = md("This Week's Predictions"),
    #subtitle = md(glue("Week {length(results)}"))
    ) %>% 
   tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(Correct),
      rows = Correct =="No"
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(Correct),
      rows = Correct =="Yes"
    )) %>% 
  tab_options(
    data_row.padding = px(3),
    container.height = "100%"
   )
```

```{r Weekly and season Group Results, include=FALSE}
# Printing the weekly and season win percentage     

#how many games correct, incorrect, and not picked each week
weekly_group_correct = map(results, weekly_group_correct_fn)  

#how many games were picked each week
weekly_games_picked = map2(weekly_group_correct, weekly_number_of_games, weekly_games_picked_fn)

#Calculating the number of correct picks for each week
weekly_group_correct_picks = map(weekly_group_correct, weekly_group_correct_picks_fn)

# Code to manually hard code in week where we get 0 games correct
# ##### Remove this line before next season 
#weekly_group_correct_picks[[21]]=0

#Calculating weekly win percentage
weekly_win_percentage = map2(weekly_group_correct_picks, weekly_games_picked, weekly_win_percentage_fn)

#Calculating season win percentage
season_win_percentage = round(sum(unlist(weekly_group_correct_picks))/sum(unlist(weekly_games_picked)),4)

#Calculating number of games picked this season
season_games = sum(unlist(weekly_games_picked))

#calculating season wins
season_wins = sum(unlist(weekly_group_correct_picks))

#calculating the number of people who picked this week
Total = dim(inst.picks[[length(weeks)]])[1]
```

```{r plotting group results, include=FALSE}
#Previous Weeks
group_season_for_plotting = unlist(weekly_win_percentage) %>% as.data.frame() %>% 
  rename(`Win Percentage` = ".") %>% 
  add_column(Week = unlist(weeks))
```

```{r Plotting the group results, echo=FALSE}
inst_group_season_plot = group_season_for_plotting %>% 
ggplot(aes(x = as.factor(Week), y = `Win Percentage`))+
  geom_point()+
  geom_path(aes(x = Week))+
  ylim(c(0, 1)) +
  xlab("NFL Week") + 
  ylab("Correct Percentage")+
  ggtitle("Weekly Group Correct Percentage")+
  theme_classic()+
  theme(plot.title = element_text(hjust = 0.5, size = 18))
```

```{r beating cbs week, include=FALSE}
#Creating a list of correct percentages for each week.
cbs_weekly_percent = map(weeks, cbs_percent)

#Creating a list of how many cbs experts we beat each week.
cbs_experts_beat = map2(cbs_weekly_percent, weekly_win_percentage, experts_beat)

#Creating a list of how many cbs experts picked each week.  
cbs_experts_total = map(cbs_weekly_percent, experts_tot)
```

```{r beating cbs season, include=FALSE}
#Creating a list of correct percentages for each week.
cbs_season_percent = map(weeks, cbs_season_percent)

#Creating a list of how many cbs experts we beat each week.
cbs_experts_beat_season = map2(cbs_season_percent, season_win_percentage, experts_beat)

#Creating a list of how many cbs experts picked each week.  
cbs_experts_season_total = map(cbs_season_percent, experts_tot)
```

```{r beating ESPN week, include=FALSE}
#Creating a list of correct percentages for each week.
espn_weekly_percent = map(weeks, espn_percent)

#Creating a list of how many cbs experts we beat each week.
espn_experts_beat = map2(espn_weekly_percent, weekly_win_percentage, experts_beat)

#Creating a list of how many cbs experts picked each week.  
espn_experts_total = map(espn_weekly_percent, experts_tot)
```

```{r beating ESPN season, include=FALSE}
#Creating a list of correct percentages for each week.
espn_season_percent = map(weeks, espn_season_percent)

#Creating a list of how many cbs experts we beat each week.
espn_experts_beat_season = map2(espn_season_percent, season_win_percentage, experts_beat)

#Creating a list of how many cbs experts picked each week.  
espn_experts_season_total = map(espn_season_percent, experts_tot)
```

```{r individual results, include=FALSE}
#Creating a list of individual results for each week.
weekly_indiv = pmap(list(inst.picks, winners, weeks), indiv_weekly_pred)

#Combining each week into one dataframe and calculating percentage Correct for this week.  
full_season = weekly_indiv %>% reduce(full_join, by = "Name") %>% 
  mutate(Percent = round(pull(.[,ncol(.)]/weekly_number_of_games[[length(weekly_number_of_games)]]),4)) 

#Creating a dataframe with only the weekly picks
a = full_season %>% select(starts_with("Week"))

#Creating a vector of how many weeks each person picked over the season
tot_week = NULL
help = NULL
for (i in 1:dim(a)[1]){
  for(j in 1:length(a)){
    help[j] = ifelse(is.na(a[i,j])==T,0,1)
    tot_week[i] = sum(help)
  }
}

#Creating a vector of how many games each person picked over the season
tot_picks= NULL
help = NULL
for (i in 1:dim(a)[1]){
  for(j in 1:length(a)){
    help[j] = unlist(weekly_games_picked)[j]*ifelse(is.na(a[i,j])==T,0,1)
    tot_picks[i] = sum(help)
  }
}

#Creatign a vector of how many games each person picked correct over the season
tot_correct = NULL
help = NULL
for (i in 1:dim(a)[1]){
  tot_correct[i] = sum(a[i,], na.rm = T)
}

#adding how many weeks each person picked, season correct percentage, and adjusted season percentag to the data frame and sorting the data
indiv_disp = full_season %>% add_column(`Weeks Picked` = tot_week) %>%
  add_column(tot_correct)%>%
  add_column(tot_picks)%>%
  mutate(`Season Percent` = round(tot_correct/tot_picks,4))%>%
  mutate(`Adj Season Percent` = round(`Season Percent`*(tot_week/length(a)),4)) %>%
  select(-tot_correct, -tot_picks) %>%
  arrange(desc(Percent), desc(`Season Percent`)) %>%
  mutate(Percent = ifelse(is.na(Percent)==T, 0, Percent))
```


```{r individual percentages, include=FALSE}
#Calculating individual percentages for each week.
weekly_indiv_percent = map2(weekly_indiv, as.list(weekly_number_of_games), indiv_percent) %>% reduce(full_join, by = "Name")

weekly_indiv_percent_plot = weekly_indiv_percent %>% 
  pivot_longer(cols = starts_with("Week"), names_to = "Week", values_to = "Percent")%>%
  mutate(Percent = ifelse(is.na(Percent)==T, 0, Percent)) %>% 
  mutate(Week = as.factor(Week))

levels = NULL
for(i in 1:length(weeks)){
  levels[i] = glue("Week {i}")  
}

weekly_indiv_percent_plot = weekly_indiv_percent_plot %>%
  mutate(Week = factor(Week, levels))
```

```{r sparklines, include=FALSE}
#adding sparklines
plot_group = function(name, df){
  plot_object = 
    ggplot(data = df,
           aes(x = as.factor(Week), y=Percent, group = 1))+
    geom_path(size = 7)+
    scale_y_continuous(limits = c(0,1))+
    theme_void()+
    theme(legend.position = "none")
  return(plot_object)
}

sparklines = 
  weekly_indiv_percent_plot %>% 
  group_by(Name) %>% 
  nest() %>% 
  mutate(plot = map2(Name, data, plot_group)) %>% 
  select(-data)
  
indiv_disp_2 = indiv_disp %>% 
  inner_join(sparklines, by = "Name") %>% 
  mutate(`Season Trend` = NA)
```

```{r Printing Individual Table2, echo=FALSE}
# Printing the individual Table
indiv_table = indiv_disp_2 %>% gt() %>% 
  cols_align(
    align = "center") %>% 
   tab_header(
    title = md("Individual Results"),
    subtitle = md(glue("Week {length(weeks)}"))
    ) %>% 
   tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(Percent),
      rows = Percent<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(Percent),
      rows = Percent>.5
    )) %>% 
     tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(`Season Percent`),
      rows = `Season Percent`<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(`Season Percent`),
      rows = `Season Percent`>.5
    ))%>% 
     tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(`Adj Season Percent`),
      rows = `Adj Season Percent`<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(`Adj Season Percent`),
      rows = `Adj Season Percent`>.5
    )) %>% 
  tab_options(
    container.width = pct(100),
    data_row.padding = px(1),
    container.height = "100%"
   ) %>%
    tab_spanner(
    label = "Weekly # Correct",
    columns = starts_with(c("Week "))
  ) %>% 
  text_transform(
    locations = cells_body(c(`Season Trend`)),
    fn = function(x){
      map(indiv_disp_2$plot, ggplot_image, height = px(30), aspect_ratio = 4)
                 }) %>%
  cols_hide(c(plot))

indiv_winners = indiv_disp_2 %>% filter(Percent == max(Percent)) %>% select(Name) %>% pull() %>% paste(collapse = ", ")
indiv_season = indiv_disp_2 %>% filter(`Season Percent` == max(`Season Percent`)) %>% select(Name) %>% pull() %>% paste(collapse = ", ")
indiv_season_adj = indiv_disp_2 %>% filter(`Adj Season Percent` == max(`Adj Season Percent`)) %>% select(Name) %>% pull()%>% paste(collapse = ", ")
```

```{r Printing Season Leaderboard, echo=FALSE}
# Printing the Season Leaderboard
  
season_leaderboard_disp = indiv_disp_2 %>% select(Name, starts_with("Week ")) %>% 
  pivot_longer(starts_with("Week"),names_to = "Week", values_to = "Correct") %>% 
  group_by(Week) %>% 
  mutate(Correct = case_when(is.na(Correct)==T~0, 
                             TRUE~Correct)) %>% 
  mutate(Donut = case_when(Correct==max(Correct)~1,
                           TRUE~0))  %>% 
  ungroup() %>% 
  group_by(Name) %>% 
  summarise(`Donuts Won` = sum(Donut)) %>% 
  #mutate(`Donuts Won` = strrep("award,", Donuts)) %>% 
  right_join(.,indiv_disp_2) %>% 
  select(-starts_with("Week "), -Percent) %>% 
  mutate(`Season Rank` = min_rank(desc(`Season Percent`)),.before = Name) %>% 
  arrange(`Season Rank`) 
  
season_leaderboard = season_leaderboard_disp %>% 
  gt() %>% 
  cols_align(
    align = "center") %>% 
   tab_header(
    title = md("Season Leaderboard (Season Percent)"),
    subtitle = md(glue("Week {length(weeks)}"))
    ) %>% 
  # fmt_icon(
  #   columns = `Donuts Won`,
  #   fill_color = "gold",
  # ) %>%
  tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(`Season Percent`),
      rows = `Season Percent`<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(`Season Percent`),
      rows = `Season Percent`>.5
    ))%>% 
     tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(`Adj Season Percent`),
      rows = `Adj Season Percent`<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(`Adj Season Percent`),
      rows = `Adj Season Percent`>.5
    )) %>% 
  tab_options(
    container.width = pct(100),
    data_row.padding = px(1),
    container.height = "100%"
   ) %>%
    tab_spanner(
    label = "Weekly # Correct",
    columns = starts_with(c("Week "))
  ) %>% 
  text_transform(
    locations = cells_body(c(`Season Trend`)),
    fn = function(x){
      map(season_leaderboard_disp$plot, ggplot_image, height = px(30), aspect_ratio = 4)
                 }) %>%
  cols_hide(columns = c(plot))
```

```{r Printing Adj Season Leaderboard, echo=FALSE}
# Printing the Adj Season Leaderboard
  
adj_season_leaderboard_disp = indiv_disp_2 %>% select(Name, starts_with("Week ")) %>% 
  pivot_longer(starts_with("Week"),names_to = "Week", values_to = "Correct") %>% 
  group_by(Week) %>% 
  mutate(Correct = case_when(is.na(Correct)==T~0, 
                             TRUE~Correct)) %>% 
  mutate(Donut = case_when(Correct==max(Correct)~1,
                           TRUE~0))  %>% 
  ungroup() %>% 
  group_by(Name) %>% 
  summarise(`Donuts Won` = sum(Donut)) %>% 
  #mutate(`Donuts Won` = strrep("award,", Donuts)) %>% 
  right_join(.,indiv_disp_2) %>% 
  select(-starts_with("Week "), -Percent) %>% 
  mutate(`Season Rank` = min_rank(desc(`Adj Season Percent`)),.before = Name) %>% 
  arrange(`Season Rank`)

adj_season_leaderboard = adj_season_leaderboard_disp %>% 
  gt() %>% 
  cols_align(
    align = "center") %>% 
   tab_header(
    title = md("Season Leaderboard (Adjusted Season Percent)"),
    subtitle = md(glue("Week {length(weeks)}"))
    ) %>% 
  # fmt_icon(
  #   columns = `Donuts Won`,
  #   fill_color = "gold",
  # ) %>%
  tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(`Season Percent`),
      rows = `Season Percent`<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(`Season Percent`),
      rows = `Season Percent`>.5
    ))%>% 
     tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(`Adj Season Percent`),
      rows = `Adj Season Percent`<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(`Adj Season Percent`),
      rows = `Adj Season Percent`>.5
    )) %>% 
  tab_options(
    container.width = pct(100),
    data_row.padding = px(1),
    container.height = "100%"
   ) %>%
    tab_spanner(
    label = "Weekly # Correct",
    columns = starts_with(c("Week "))
  ) %>% 
  text_transform(
    locations = cells_body(c(`Season Trend`)),
    fn = function(x){
      map(adj_season_leaderboard_disp$plot, ggplot_image, height = px(30), aspect_ratio = 4)
                 }) %>%
  cols_hide(columns = c(plot))
```


```{r instructor formattable, echo=FALSE}
improvement_formatter <- 
  formatter("span", 
            style = x ~ formattable::style(
              font.weight = "bold", 
              color = ifelse(x > .5, "green", ifelse(x < .5, "red", "black"))),
             x ~ icontext(ifelse(x == max(x), "star", ""), x))

indiv_disp_3 = indiv_disp_2 %>% select(-plot)
indiv_disp_3$`Season Trend` = apply(indiv_disp_3[,2:(1+length(weeks))], 1, FUN = function(x) as.character(htmltools::as.tags(sparkline(as.numeric(x), type = "line", chartRangeMin = 0, chartRangeMax = 1, fillColor = "white"))))

indiv_table_2 = as.htmlwidget(formattable(indiv_disp_3, 
                                align = c("l", rep("c", NROW(indiv_disp_3)-1)),
              list(`Season Percent` = color_bar("#FA614B"),
              `Season Percent`= improvement_formatter,
              `Adj Season Percent`= improvement_formatter)))
              
indiv_table_2$dependencies = c(indiv_table_2$dependencies, htmlwidgets:::widget_dependencies("sparkline", "sparkline"))
```

```{r Plotting individual results over the season2, eval=FALSE, include=FALSE, out.width="100%"}
#Creating the individual plot.  
inst_indiv_plots = weekly_indiv_percent_plot %>% 
  ggplot(aes(x = factor(Week), y = Percent, color = Name))+
  geom_point()+
  geom_path(aes(x = as.factor(Week), y = Percent, color = Name, 
                group = Name))+
  ylim(c(0, 1)) +
  labs(x = "NFL Week", 
       y = "Correct Percentage", 
       title = "Weekly Individual Correct Percentage")+
  facet_wrap(~Name)+
  theme_classic()+
  theme(legend.position = "none",
        plot.title = element_text(hjust = 0.5, size = 18),
        axis.text.x=element_text(angle =45, vjust = 1, hjust = 1))
```

```{r data for data page}
inst.data = map2(inst.picks, weeks, disp_data) %>% bind_rows()
```


```{r fivethirtyeight}
inst_538 = map(results, five38) %>% unlist() %>% sum()
```

```{r pregame, eval=FALSE, include=FALSE}
#Predictions for the week

#Creating the list of group predictions each week.
games = map(inst.picks, games_fn)

#Creating the prediction table.  
pred_table = map(games, pred_table_fn)

#Printing table of instructor predictions
pred_table[[length(pred_table)]] %>% mutate(Game = row_number()) %>% 
  rename(`Votes For` = votes_for, `Votes Against` = votes_against) %>% 
  gt() %>% 
  cols_align(
    align = "center") %>% 
   tab_header(
    title = md("This Week's Predictions"),
    subtitle = md(glue("Week {length(weeks)}"))
    ) %>% 
   tab_options(
    data_row.padding = px(3)
   )
```

Group Predictions
==========================================================================

Sidebar {.sidebar} 
-------------------------------------
#### CBS Sports

<font size="4">

This week we beat or tied `r cbs_experts_beat[[length(weeks)]]` of `r cbs_experts_total[[length(weeks)]]` CBS Sports' Experts.

For the season we are currently beating or tied with `r cbs_experts_beat_season[[length(weeks)]]` of `r cbs_experts_season_total[[length(weeks)]]` CBS Sports' Experts.
 
 </font>


#### ESPN

<font size="4">

We also beat or tied `r espn_experts_beat[[length(weeks)]]` of `r espn_experts_total[[length(weeks)]]` ESPN Experts.
 
For the season we are currently beating or tied with `r espn_experts_beat_season[[length(weeks)]]` of `r espn_experts_season_total[[length(weeks)]]` ESPN Experts.

</font>

Row
--------------------------------------

### Win percentage for the week

```{r}
inst_rate <- weekly_win_percentage[[length(weekly_win_percentage)]]*100
gauge(inst_rate, min = 0, max = 100, symbol = '%', gaugeSectors(
  success = c(55, 100), warning = c(40, 54), danger = c(0, 39)
))
```

### Season Win Percentage

```{r}
inst_season <- season_win_percentage*100
gauge(inst_season, min = 0, max = 100, symbol = '%', gaugeSectors(
  success = c(55, 100), warning = c(40, 54), danger = c(0, 39)
))
```

### Games Correct
```{r}
valueBox(value = season_wins,icon = "fa-trophy",caption = "Correct Games this Season")
```

### Games Picked
```{r}
valueBox(value = season_games,icon = "fa-clipboard-list",caption = "Games Picked this Season")
```

### Number of predictions
```{r}
valueBox(value = Total,icon = "fa-users",caption = "Predictions this week")
```

Row
--------------------------------------

### 

```{r}
inst_group_table
```

### 

```{r}
ggplotly(inst_group_season_plot) %>% 
  layout(title = list(y = .93, xref = "plot"),
         margin = list(t = 40))
```

Individual Predictions
==========================================================================


Sidebar {.sidebar} 
-------------------------------------

#### Best Picks of the Week.

<font size="4">

 `r indiv_winners`
 
 </font>
 
#### Best Season Correct Percentage
<font size="4">

`r indiv_season`
 
 </font>

#### Best Adjusted Season Correct Percentage
<font size="4">

`r indiv_season_adj`

 * Adjusted season percentage accounts for the number of weeks picked.
 
 </font>

row {.tabset}
--------------------------------------

### Individual Table
```{r, results='asis', error=FALSE}
indiv_table
```

<!--
### Individual Table2

```{r, out.height="100%"}
indiv_table_2
```

-->

<!--

### Individual Plots
```{r, out.width="100%"}
#ggplotly(inst_indiv_plots)
```

-->

### Season Leaderboard
```{r, results='asis', error=FALSE}
season_leaderboard
```

### Adjusted Season Leaderboard
```{r, results='asis', error=FALSE}
adj_season_leaderboard
```

Data
==========================================================================

```{r}
datatable(
  inst.data, extensions = 'Buttons', options = list(
    dom = 'Blfrtip',
    buttons = c('copy', 'csv', 'excel', 'pdf', 'print'),
    lengthMenue = list( c(10, 25, 50, 100, -1), c(10, 25, 50, 100, "All") )
  )
)
```